Syntax24.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
(* Notify Ralf for maintenance of Non-FPU source *)
MODULE IconElems; (* gri 18.3.91 / 28.9.93 *)
	IMPORT Input, Display, Oberon, Math, Viewers, Files, Printer, Texts, TextFrames, TextPrinter;
	CONST
		IStag = 753; (* icon stretch tag *)
		left = 2; middle = 1; right = 0; (* mouse keys *)
		HSide = MAX(SET)+1; Side = 2*HSide; PDot = 3; (* dimensions *)
		MaxN = 64; Sleep = 100; (* in ms *)
	TYPE
		Icon = ARRAY 2 OF RECORD
			addr: LONGINT;
			image: ARRAY Side+1 OF SET
		END;
		Elem = POINTER TO ElemDesc;
		ElemDesc = RECORD (Texts.ElemDesc)
		END;
		Frame = POINTER TO RECORD(Display.FrameDesc) col: SHORTINT END;
		NotifyMsg = RECORD(TextFrames.NotifyMsg) END;
		N: LONGINT; (* no. of figurs *)
		Task: Oberon.Task;
		State: LONGINT; (* actual figure state *)
		Fig: ARRAY MaxN OF Icon;
	PROCEDURE EmptyFig;
		VAR j: INTEGER;
	BEGIN N := 1; j := 1;
		WHILE j <= Side DO
			Fig[0, 0].image[j] := {};
			Fig[0, 1].image[j] := {};
			INC(j)
		END;
		Fig[0, 0].addr := Display.NewPattern(Fig[0, 0].image, HSide, Side);
		Fig[0, 1].addr := Display.NewPattern(Fig[0, 1].image, HSide, Side)
	END EmptyFig;
	PROCEDURE LoadFig (file: ARRAY OF CHAR); (* read portable file format *)
		VAR F: Files.File; R: Files.Rider; i, j: INTEGER;
		PROCEDURE ReadInt (VAR x: LONGINT);
			VAR n: LONGINT; i: SHORTINT; ch: CHAR;
		BEGIN i := 0; n := 0; Files.Read(R, ch);
			WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, i)); INC(i, 7); Files.Read(R, ch) END;
			x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, i)
		END ReadInt;
		PROCEDURE ReadSet (VAR s: SET);
			VAR x: LONGINT; i: INTEGER;
		BEGIN ReadInt(x); s := {}; i := 0;
			WHILE i < 32 DO
				IF ODD(x) THEN INCL(s, i) END;
				x := x DIV 2; INC(i)
			END
		END ReadSet;
	BEGIN F := Files.Old(file);
		IF F = NIL THEN EmptyFig; RETURN END;
		Files.Set(R, F, 0); ReadInt(N);
		IF N # IStag THEN EmptyFig; RETURN END;
		ReadInt(N); i := 0;
		WHILE i <= N DO j := 1;
			WHILE j <= Side DO
				ReadSet(Fig[i, 0].image[j]);
				ReadSet(Fig[i, 1].image[j]);
				INC(j)
			END;
			Fig[i, 0].addr := Display.NewPattern(Fig[i, 0].image, HSide, Side);
			Fig[i, 1].addr := Display.NewPattern(Fig[i, 1].image, HSide, Side);
			INC(i)
		END
	END LoadFig;
	PROCEDURE Draw (VAR icn: Icon; x, y, color: INTEGER);
	BEGIN
		Display.CopyPattern(color, icn[0].addr, x, y, Display.invert);
		Display.CopyPattern(color, icn[1].addr, x + HSide, y, Display.invert)
	END Draw;
	PROCEDURE Print (VAR icn: Icon; x, y: INTEGER);
		VAR i: INTEGER;
		PROCEDURE PrintLine (x, y: INTEGER; line: SET);
			VAR i, i0: INTEGER;
		BEGIN i := 0;
			WHILE i < HSide DO
				IF i IN line THEN i0 := i; INC(i);
					WHILE (i < HSide) & (i IN line) DO INC(i) END;
					Printer.ReplConst(x + i0*PDot, y, (i-i0)*PDot, PDot)
				END;
				INC(i)
			END
		END PrintLine;
	BEGIN i := 0;
		WHILE i < Side DO
			PrintLine(x, y + i*PDot, icn[0].image[i+1]);
			PrintLine(x + HSide*PDot, y + i*PDot, icn[1].image[i+1]);
			INC(i)
		END
	END Print;
	PROCEDURE HotSpot (X, Y, W, H, X0, Y0: INTEGER);
		CONST d = 6;
		VAR dx, dy: LONGINT; r: INTEGER;
		PROCEDURE Block (x, y, w, h, col, mode: INTEGER);
		BEGIN
			IF x < X THEN DEC(w, X-x); x := X END;
			IF x+w > X+W THEN w := X+W-x END;
			IF w <= 0 THEN RETURN END;
			IF y < Y THEN DEC(h, Y-y); y := Y END;
			IF y+h > Y+H THEN h := Y+H-y END;
			IF h <= 0 THEN RETURN END;
			Display.ReplConst(col, x, y, w, h, mode)
		END Block;
		PROCEDURE Dot4 (x1, x2, y1, y2, col, mode: INTEGER);
			CONST r = (d+1) DIV 2;
		BEGIN
			Block(x1-r, y1-r, 2*r+1, 2*r+1, col, mode);
			Block(x1-r, y2-r, 2*r+1, 2*r+1, col, mode);
			Block(x2-r, y1-r, 2*r+1, 2*r+1, col, mode);
			Block(x2-r, y2-r, 2*r+1, 2*r+1, col, mode)
		END Dot4;
		PROCEDURE Circle (X, Y, R, col, mode: INTEGER);
			VAR x, y, dx, dy, d: INTEGER;
		BEGIN
			x := R; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*R;
			WHILE x > y DO
				Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode);
				Dot4(X-y-1, X+y, Y-x-1, Y+x, col, mode);
				INC(d, dy); INC(dy, 8); INC(y);
				IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
			END;
			IF x = y THEN Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode) END
		END Circle;
	BEGIN
		IF X0-X > X+W-X0 THEN dx := X0-X ELSE dx := X+W-X0 END;
		IF Y0-Y > Y+H-Y0 THEN dy := Y0-Y ELSE dy := Y+H-Y0 END;
		r := SHORT(ENTIER(Math.sqrt(dx*dx + dy*dy)));
		WHILE r > 0 DO Circle(X0, Y0, r, Display.black, Display.replace); DEC(r, d) END
	END HotSpot;
	PROCEDURE SaveScreen (x0, y0: INTEGER; keys: SET; col: SHORTINT);
		VAR sum: SET; x, y, w, h: INTEGER; msg: Viewers.ViewerMsg; wakeUp: LONGINT;
	BEGIN
		Display.ReplConst(Display.white, x0, y0, Side, Side, Display.invert); sum := keys;
		REPEAT
			Input.Mouse(keys, x, y); sum := sum+keys; 
			Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
		UNTIL keys = {};
		Display.ReplConst(Display.white, x0, y0, Side, Side, Display.invert);
		IF sum # {left, middle, right} THEN
			x := Oberon.UserTrack(x0); w := Oberon.DisplayWidth(x0);
			y := Display.Bottom; h := Oberon.DisplayHeight(x0);
			Oberon.RemoveMarks(x, y, w, h);
			msg.id := Viewers.suspend; Viewers.Broadcast(msg);
			HotSpot(x, y, w, h, x0 + Side DIV 2, y0 + Side DIV 2);
			REPEAT
				Display.ReplConst(Display.black, x0, y0, Side, Side, Display.replace);
				INC(State); INC(x0, 10);
				IF x0+Side > x+w THEN x0 := x; INC(y0, Side);
					IF y0+Side > y+h THEN y0 := y END
				END;
				Draw(Fig[State MOD N], x0, y0, col);
				wakeUp := Oberon.Time() + Sleep*Input.TimeUnit DIV 1000;
				REPEAT UNTIL Oberon.Time() >= wakeUp
			UNTIL Input.Available() > 0;
			msg.id := Viewers.restore; Viewers.Broadcast(msg)
		END
	END SaveScreen;
	PROCEDURE HandleFrame (F: Display.Frame; VAR M: Display.FrameMsg);
		VAR r: INTEGER;
	BEGIN
		WITH F: Frame DO
			IF M IS NotifyMsg THEN
				WITH M: NotifyMsg DO
					Draw(Fig[(State-1) MOD N], F.X, F.Y, F.col);
					Draw(Fig[State MOD N], F.X, F.Y, F.col)
				END
			ELSIF M IS Oberon.InputMsg THEN
				WITH M: Oberon.InputMsg DO
					IF M.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y) END
				END
			END
		END
	END HandleFrame;
	PROCEDURE Handle (E: Texts.Elem; VAR msg: Texts.ElemMsg);
		VAR e: Elem; ch: CHAR; F: Frame;
	BEGIN
		WITH E: Elem DO
			IF msg IS TextFrames.DisplayMsg THEN
				WITH msg: TextFrames.DisplayMsg DO
					IF ~msg.prepare THEN
						Draw(Fig[State MOD N], msg.X0, msg.Y0, msg.col);
						NEW(F); F.handle := HandleFrame; F.X := msg.X0; F.Y := msg.Y0; F.W := 64; F.H := 64; F.col := msg.col;
						msg.elemFrame := F
					END
				END
			ELSIF msg IS TextPrinter.PrintMsg THEN
				WITH msg: TextPrinter.PrintMsg DO
					IF msg.prepare THEN
						E.W := Side * TextPrinter.Unit * PDot; E.H := E.W
					ELSE
						Print(Fig[State MOD N], msg.X0, msg.Y0);
						E.W := Side * TextFrames.Unit; E.H := E.W
					END
				END
			ELSIF msg IS Texts.CopyMsg THEN
				NEW(e); Texts.CopyElem(E, e); msg(Texts.CopyMsg).e := e
			ELSIF msg IS TextFrames.TrackMsg THEN
				WITH msg: TextFrames.TrackMsg DO
					IF middle IN msg.keys THEN SaveScreen(msg.X0, msg.Y0, msg.keys, msg.col) END
				END
			ELSIF msg IS Texts.IdentifyMsg THEN
				WITH msg: Texts.IdentifyMsg DO
					msg.mod := "IconElems"; msg.proc := "New"
				END
			ELSIF msg IS Texts.FileMsg THEN
				WITH msg: Texts.FileMsg DO
					IF msg.id = Texts.load THEN Files.Read(msg.r, ch) (* ignore in this version *)
					ELSIF msg.id = Texts.store THEN Files.Write(msg.r, 0X); (* version tag: used for future extensions *)
					END
				END
			END
		END
	END Handle;
	PROCEDURE Step;
		VAR msg: NotifyMsg;
	BEGIN
		INC(State); Viewers.Broadcast(msg);
		Oberon.CurTask.time := Oberon.Time() + Sleep*Input.TimeUnit DIV 1000
	END Step;
	PROCEDURE New*;
		VAR E: Elem;
	BEGIN NEW(E); E.handle := Handle; Texts.new := E; Oberon.Install(Task)
	END New;
	PROCEDURE Insert*;
		VAR E: Elem; m: TextFrames.InsertElemMsg;
	BEGIN NEW(E); E.W := Side * TextFrames.Unit; E.H := E.W; E.handle := Handle; m.e := E;
		Oberon.FocusViewer.handle(Oberon.FocusViewer, m);
		Oberon.Install(Task)
	END Insert;
	PROCEDURE Stop*;
	BEGIN Oberon.Remove(Task);
	END Stop;
BEGIN
	LoadFig("IconElems.Icon"); State := 0;
	NEW(Task); Task.safe := FALSE; Task.time := 0; Task.handle := Step; Oberon.Install(Task)
END IconElems.